home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / xmas1983.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  11.2 KB  |  209 lines
  1. 10  'XMAS1983.BAS
  2. 20  'AUTHOR:  Brad Henke
  3. 30  'DATE:    Dec. 11, 1983.
  4. 40  '
  5. 50  RANDOMIZE VAL(RIGHT$(TIME$,2))
  6. 60  ADDRESSPORT=&H3D4:DATAPORT=&H3D5:MODEPORT=&H3D8:COLORPORT=&H3D9:STATUSPORT=&H3DA
  7. 70  BLACK=0:WHITE=7:FIRSTTIME=-1:MUSIC=-1
  8. 80  MODESAVE=&H465     'BIOS saves mode reg here
  9. 90  COLORSAVE=&H466    'BIOS saves color reg here
  10. 100  DIM REGS(12),REGSV(12),ROW(12),COL(12),LNG(12),FLDVAL(12)
  11. 110  KEY OFF:SCREEN 0,1:WIDTH 80:WIDTH 40:WIDTH 80
  12. 120  RESTORE 960:GOSUB 190           '80x100 alpha graphics
  13. 130  IN$=INKEY$:IF IN$="" THEN 130
  14. 140  IF IN$=" " THEN 430
  15. 150  IF IN$=CHR$(27) THEN CLS:PRINT "CHRISTMAS IS OVER":END
  16. 160  IF IN$="M" OR IN$="m" THEN MUSIC=ABS(MUSIC)-1
  17. 170  GOTO 130
  18. 180  '
  19. 190  'load new parameters into 6845 CRT Controller
  20. 200  IF FIRSTTIME THEN FIRSTTIME=0:READ MODEDESC$:READ MODE:FOR REG=0 TO 11:READ REGS(REG):REGSV(REG)=REGS(REG):NEXT REG
  21. 210  SCREEN 0:WIDTH 80
  22. 220  CLS:
  23. 230  LOCATE 1,32,0:PRINT "MERRY CHRISTMAS"
  24. 240  LOCATE 3,37:PRINT "from"
  25. 250  LOCATE 5,34:PRINT "Brad Henke"
  26. 260  LOCATE 7,1:PRINT "This program demonstrates the use of 80x100 low-resolution text to produce"
  27. 270  LOCATE 8,1:PRINT "sixteen-color pictures.  Because I have to reset the color-graphics"
  28. 280  LOCATE 9,1:PRINT "controller chip, you should not end this program by using the "
  29. 290  LOCATE 10,1:PRINT "Ctrl-ScrollLock/Break keys... your screen will be unreadable unless you"
  30. 300  LOCATE 11,1:PRINT "press <ESC>. (If you must, you may recover your screen by typing 'WIDTH 40'.)"
  31. 310  LOCATE 13,1:PRINT "You may toggle music on/off by pressing the M key (current song will finish)."
  32. 320  LOCATE 14,1:PRINT "The program will play a random selection of Christmas tunes until you exit the"
  33. 330  LOCATE 15,1:PRINT "program (or turn the music off with the M key)."
  34. 340  LOCATE 17,1:PRINT "For those of you who write BASIC, the code to BSAVE and BLOAD the picture"
  35. 350  LOCATE 18,1:PRINT "is commented in the program.  Since it takes a long time to poke all the color"
  36. 360  LOCATE 19,1:PRINT "'dots' onto the screen, you may want to modify the program slightly. (I"
  37. 370  LOCATE 20,1:PRINT "wanted to leave all the original code in to illustrate the technique.)"
  38. 380  LOCATE 22,1:PRINT "This program must be run on a color (RGB) monitor.  If you are not using"
  39. 390  LOCATE 23,1:PRINT "the right monitor, please press <ESC> to exit."
  40. 400  LOCATE 25,1:PRINT"Press <Space> to run XMAS1983";
  41. 410  LOCATE 25,52:PRINT "Press <Esc> to end program";
  42. 420  RETURN
  43. 430  '
  44. 440  DEF SEG=0
  45. 450  MODESET=0                                    'turn off video
  46. 460  POKE MODESAVE,MODESET:OUT MODEPORT,MODESET   'during setup
  47. 470  POKE COLORSAVE,BLACK:OUT COLORPORT,BLACK
  48. 480  FOR REG=0 TO 11
  49. 490     OUT ADDRESSPORT,REG:  OUT DATAPORT,REGS(REG)
  50. 500  NEXT REG
  51. 510  POKE MODESAVE,MODE:OUT MODEPORT,MODE         'Set Mode
  52. 520  GOSUB 580 'perform tree etc.
  53. 530  GOSUB 1520:IN$=INKEY$:IF IN$="" THEN GOTO 530
  54. 540  IF IN$="M" OR IN$="m" THEN MUSIC=ABS(MUSIC)-1:GOTO 530
  55. 550  SCREEN 0:WIDTH 40:WIDTH 80
  56. 560  LOCATE 5,10:PRINT "Christmas is over...":LOCATE 24,1:END
  57. 570  '
  58. 580  'xmas tree - 80x100 alpha graphics
  59. 590  COLOR WHITE,BLACK,BLACK
  60. 600  DEF SEG=&HB800
  61. 610  '********************************
  62. 620  '    BLOAD"XMAS.PIC":RETURN
  63. 630  '********************************
  64. 640  CLS:CLR=0:X=0
  65. 650  RESTORE 1140                  'draw tree
  66. 660  CLR=2
  67. 670  READ Y:IF Y=999 THEN GOTO 770
  68. 680  OLDX=X:READ X:IF X=999 THEN GOTO 660
  69. 690  IF X<0 THEN MAX=OLDX+2*ABS(X):X=OLDX ELSE MAX=0
  70. 700  I=RND(1):IF I>0.8 THEN CLR=INT(16*RND(1))
  71. 710  GOSUB 880
  72. 720  CLR=2
  73. 730  IF MAX=0 THEN 680
  74. 740  X=X+2:IF X>MAX THEN 680 ELSE 700
  75. 750  GOTO 680
  76. 760  '
  77. 770  READ CLR:IF CLR=999 THEN 850            'draw presents
  78. 780  READ Y
  79. 790  OLDX=X:READ X:IF X=999 THEN 770
  80. 800  IF X<0 THEN MAX=OLDX+2*ABS(X):X=OLDX ELSE MAX=0
  81. 810  GOSUB 880
  82. 820  IF MAX=0 THEN 790
  83. 830  X=X+2:IF X>MAX THEN 790 ELSE 810
  84. 840  '*****************************************************
  85. 850  '   DEF SEG=&HB800:BSAVE"XMAS.PIC",0,&H4000:RETURN
  86. 860  '*****************************************************
  87. 870  RETURN
  88. 880  'plot points
  89. 890    PIXEL%=X+(Y*160):PIXELADDR=(PIXEL% AND &HFFFE)+1
  90. 900    NIBBLE=PIXEL% MOD 2
  91. 910    IF NIBBLE=0 THEN POKE PIXELADDR,(PEEK(PIXELADDR) AND &HF)+CLR*&H10
  92. 920    IF NIBBLE<>0 THEN POKE PIXELADDR,(PEEK(PIXELADDR) AND &HF0)+CLR
  93. 930  RETURN
  94. 940  RETURN
  95. 950  '
  96. 960  'Initial data for 6845 (80x100 alpha graphics)
  97. 970  '160x100 alpha graphics should be possible also but
  98. 980  'I haven't figured out the settings yet...    Brad
  99. 990  DATA "80x100 GRAPHICS"
  100. 1000  DATA   9 :'mode=hires+video (160x100)
  101. 1010  DATA 113 :'-- R0  Horizontal Total
  102. 1020  DATA  80 :'-- R1  Horizontal Displayed
  103. 1030  DATA  90 :'-- R2  Horizontal Sync Position
  104. 1040  DATA  10 :'-- R3  Horizontal Sync Width
  105. 1050  DATA 127 :'-- R4  Vertical Total
  106. 1060  DATA   6 :'-- R5  Vertical Adjust
  107. 1070  DATA 100 :'-- R6  Vertical Displayed
  108. 1080  DATA 112 :'-- R7  Vertical Sync Position
  109. 1090  DATA   2 :'-- R8  Interlace Mode
  110. 1100  DATA   1 :'-- R9  Maximum Scan Line Address
  111. 1110  DATA  32 :'-- R10 Cursor Start  (32 disables cursor display)
  112. 1120  DATA   0 :'-- R11 Cursor End
  113. 1130  '
  114. 1140  'data for xmas tree
  115. 1150  DATA 10,80,999,11,78,-2,999,12,76,-4,999,13,74,-6,999,14,76,-4,999
  116. 1160  DATA 15,74,-6,999,16,72,-8,999,17,74,-6,999,18,72,-8,999,19,70,-10,999
  117. 1170  DATA 20,68,-12,999,21,70,-12,999,22,68,-12,999,23,70,-12,999
  118. 1180  DATA 24,68,-14,999,25,66,-16,999,26,64,-18,999,27,68,-15,999
  119. 1190  DATA 28,66,-15,999,29,64,-17,999,30,66,-17,999,31,64,-17,999
  120. 1200  DATA 32,62,-19,999,33,60,-21,999,34,58,-21,999,35,60,-21,999
  121. 1210  DATA 36,62,-21,999,37,60,-22,999,38,58,-24,999,39,56,-23,999
  122. 1220  DATA 40,58,-23,999,41,60,-23,999,42,58,-23,999,43,56,-23,999
  123. 1230  DATA 44,54,-25,999,45,56,-25,999,46,58,-25,999,47,54,-26,999
  124. 1240  DATA 48,56,-26,999,49,54,-28,999,50,52,-30,999,51,50,-30,999
  125. 1250  DATA 52,52,-30,999,53,54,-30,999,54,52,-30,999,55,54,-30,999
  126. 1260  DATA 56,52,-32,999,57,50,-34,999,58,48,-34,999,59,52,-31,999,999
  127. 1270  DATA 6,60,78,-2,999,6,61,78,-2,999,6,62,78,-2,999
  128. 1280  DATA 12,61,44,-6,999,12,62,44,-6,999,12,63,44,-6,999
  129. 1290  DATA 9,62,54,-3,999,9,63,54,-3,999
  130. 1300  DATA 5,61,74,999,15,62,70,72,999,5,62,74,999,15,62,76,78,999
  131. 1310  DATA 15,63,70,72,999,5,63,74,999,15,63,76,78,999
  132. 1320  DATA 11,60,86,-8,999,11,61,86,-8,999,11,62,86,-8,999,11,62,86,-8,999
  133. 1330  DATA 12,58,96,999,15,58,98,999,12,58,100,999
  134. 1340  DATA 12,59,96,999,15,59,98,999,12,59,100,999
  135. 1350  DATA 12,60,96,999,15,60,98,999,12,60,100,999
  136. 1360  DATA 12,61,96,999,15,61,98,999,12,61,100,999
  137. 1370  DATA 12,62,96,999,15,62,98,999,12,62,100,999
  138. 1380  DATA 12,63,96,999,15,63,98,999,12,63,100,999
  139. 1390  DATA 14,59,110,112,114,999,10,59,116,999,14,59,118,120,122,999
  140. 1400  DATA 14,60,110,112,114,999,10,60,116,999,14,60,118,120,122,999
  141. 1410  DATA 10,61,110,112,114,999,10,61,116,999,10,61,118,120,122,999
  142. 1420  DATA 14,62,110,112,114,999,10,62,116,999,14,62,118,120,122,999
  143. 1430  DATA 14,63,110,112,114,999,10,63,116,999,14,63,118,120,122,999
  144. 1440  DATA 12,80,24,32,36,-4,48,50,52,54,60,62,64,66,72,80,96,104,108,116,124,132,-4,999
  145. 1450  DATA 12,81,24,26,30,32,36,48,56,60,68,72,80,96,104,108,110,114,116,122,126,132,140,999
  146. 1460  DATA 12,82,24,28,32,36,48,56,60,68,74,78,98,102,108,112,116,120,128,132,999
  147. 1470  DATA 12,83,24,32,36,38,40,42,48,50,52,54,60,62,64,66,74,78,100,108,116,120,128,132,-4,999
  148. 1480  DATA 12,84,24,32,36,48,54,60,66,76,98,102,108,116,120,122,124,126,128,140,999
  149. 1490  DATA 12,85,24,32,36,48,56,60,68,76,96,104,108,116,120,128,132,140,999
  150. 1500  DATA 12,86,24,32,36,38,40,42,44,48,56,60,68,76,96,104,108,116,120,128,132,-4,999
  151. 1510  DATA 999
  152. 1520  IF NOT MUSIC THEN RETURN
  153. 1530  PL1$="":S=INT(RND(1)*19+1):ON S GOSUB 1580,1600,1620,1640,1660,1680,1700,1730,1760,1780,1800,1820,1850,1870,1890,1930,1970,2010,2050
  154. 1540  PLAY "MFMN"
  155. 1550  PLAY "XPL$;XPL1$;":
  156. 1560  FOR I=1 TO 1000:NEXT I:
  157. 1570  RETURN
  158. 1580  '"ANGELS WE HAVE HEARD ON HIGH"
  159. 1590  PL$= "T120O2L4BBBO3DL4D.L8CO2L2BL4BABO3DL4O2B.L8AL2GL4BBBO3DL4D.L8CO2L2BL4BABO3DO2L4B.L8AL2GO3L2DL8EDCO2BO3L2CL8DCO2BAL2BO3L8CO2BAGL4A.L8DL2DL4GABO3CO2L2BL4AP4O3L2DL8EDCO2BO3L2CL8DCO2BAL2BO3L8CO2BAGL4A.L8DL2DL4GABO3CO2L2BAL1G":RETURN
  160. 1600  '"AWAY IN THE MANGER"
  161. 1610  PL$="T160O2L2DGGL4BAL2GGDEGEL1DL2DGGABBO3DDO2BGL1AL2DGGL4BAL2GGDEO3CO2EL1DL2DGGABO3DCO2BDF#L1G":RETURN
  162. 1620  '"DECK THE HALLS"
  163. 1630  PL$="T160O3L4C.O2L8B-L4AGFGAFL8GAB-GL4A.L8GL4FEL2FO3L4C.O2L8B-L4AGFGAFL8GAB-GL4A.L8GL4FEL2FL4G.L8AL4B-GL4A.L8B-O3L4CO2GL8ABO3L4CL8DEL4FEDL2CL4C.O2L8B-L4AGFGAFO3L8DDDDL4C.O2L8B-L4AGL2F":RETURN
  164. 1640  '"THE FIRST NOEL"
  165. 1650  PL$="T120O2L8EDL4C.L8DEFL2GL8ABO3L4CO2BAL2GL8ABL4O3CO2BAGABO3CO2GFL2EL8EDL4C.L8DEFL2GL8ABL4O3CO2BAL2GL8ABO3L4CO2BAGABO3CO2GFL2EL8EDL4C.L8DEFL2GO3L8CO2BL2AL4AL2G.O3L4CO2BAGABO3CO2GFL1E":RETURN
  166. 1660  '"GOD REST YE MERRY GENTLEMEN"
  167. 1670  PL$="T160O2L4DDAAGFEDCDEFGL2A.L4DDAAGFEDCDEFGL2A.L4AB-GAB-O3CDO2AGFDEFL2GL4FGL2AL4B-AAGFEL2DL8FEL4DL2GL4FGAB-O3CDO2AGFEL1D":RETURN
  168. 1680  '"HARK THE HERALD ANGELS SING"
  169. 1690  PL$="T160O2L4DGL4G.L8F#L4GBBAO3DDL4D.L8CO2L4BAL2BL4DGL4G.L8F#L4GBBAO3DO2AL4A.L8F#L4F#EL2DO3L4DDDO2GO3CO2BBAO3DDDO2GO3CO2BBAO3EEEDCO2BO3L2CO2L4AL8BO3CL4D.O2L8GL4GAL2BO3L4EEEDCO2BO3L2CO2L4AL8BO3CL4D.O2L8GL4GAL2G":RETURN
  170. 1700  '"HAVE YOURSELF A MERRY LITTLE CHRISTMAS"
  171. 1710  PL$="T120O2L4CEGO3CO2L8GFEDL4CDCEGO3CO2L2G.P4L4EGO3CEL8DCO2BAL4GFL1EL2E.P4L4CEGO3CO2L8GFEDL4CDCEGO3CL2O2G.P4L4EGO3CEL8DCO2BAL4G#BO3L1CCL4EEEL8DCO2BO3CL2DL8CO2BABO3L2CO2L4BL2B.P4O3L4CCCO2L8BAGAL2BL8GABO3CL2DO2L4DL2G.P4L4CEGO3CO2L8GFEDL4CDCEGO3C"
  172. 1720  PL1$="L2O2G.P4L4EGO3CEL8FEDCO2L4BO3DL1EL2E.L4EEO2FAO3CL8EDCO2BL4ABO3L1C":RETURN
  173. 1730  '"JINGLE BELLS"
  174. 1740  PL$="T192O2L4DBAGL2D.L8DDL4DBAGL2E.L4EEO3CO2BAL1F#O3L4DDCO2AL1BL4DBAGL2D.L8DDL4DBAGL2E.L4EEO3CO2BAO3DDDDEDCO2AL2G.P4L4BBL2BL4BBL2BL4BO3DO2L4G.L8AL1BO3L4CCL4C.L8CL4CO2BBL8BBL4BAABL2AO3DO2L4BBL2BL4BBL2BL4BO3DO2L4G.L8AL1BO3L4CCL4C.L8CL4CO2BBL8BB"
  175. 1750  PL1$="O3L4DDCO2L4AL1G":RETURN
  176. 1760  '"O' CHRISTMAS TREE"
  177. 1770  PL$="T120O2L4CL8F.L16FL4FGL8A.L16AL4AAL8GAL4B-EGFCL8F.L16FL4FGL8A.L16AL4AAL8GAL4B-EGFO3CL8CO2AO3L4D.L8CCO2B-L4B-.L8B-B-GO3L4C.O2L8B-B-AL4ACL8F.L16FL4FGL8A.L16AL4AAL8GAL4B-EGF":RETURN
  178. 1780  '"SILENT NIGHT"
  179. 1790  PL$="T120O2L4G.L8AL4GL2E.L4G.L8AL4GL2E.O3L2DL4DO2L2B.O3L2CL4CO2L2G.L2AL4AO3L4C.O2L8BL4AL4G.L8AL4GL2E.L2AL4AO3L4C.O2L8BL4AL4G.L8AL4GL2E.O3L2DL4DL4F.L8DO2L4BO3L2C.EL4C.O2L8GL4EL4G.L8FL4DL1C":RETURN
  180. 1800  '"MARCH OF THE TOYS"
  181. 1810  PL$="T192O3L8CDO2AO3CL2O2D.EL4AL8FL2DL8CL4EL8DL1DL8CGEDL1DP8O3L8CDO2AO3CL2O2D.EL4FL8GL2AP8L8AO3L4EL8DL4C#O2L8AO3L4EL8DL4C#O2L8AO3FEDL1AP8L8CDO2AO3CO2L2D.EL4AL8FL2DL8CL4EL8DL1DL8CGEDL1DP8O3L8CDO2AO3CO2L2D.EFGL8AB-O3CO2AGFL4AL8DL4GL8CL1F":RETURN
  182. 1820  '"SEMPER FIDELES"
  183. 1830  PL$="T192O2L8F#L4GL8AL4BP8L2BL8AGFGADP8DAP8AGP8GEP8EFP8FO3CP8CO2BP8BAP8AGP8GO3EP8EDP8DCP8CO2L4BP8L2BL8AGFGAEP8EAP8AGP8GEP8EDO1BO2DGDGBGABO3CC#DP8L8FDCO1AGO2GABO3CDL4E.GO2ABO3L4DL8CL2CL8CECECO2L4BO2L8FL2FO2L8BO3DO2BO3DO2BL4O3CL8EL2EO2L8GABO3CDL4E.G"
  184. 1840  PL1$="O2L4A.BO3L4DL8CL2CL8CO2BO3CDD#EGECECL1O2GL8AL4BL8GO3L4CP8O2L4C.L1AL8FAO3L4CO2L8AO3L2C.O2AL1FL8CFL4AL8FL2C.L4C.O3L4C.O2L1AL8FAO3L4CO2L8AO3L2C.O2AL1CL8FAO3L4CO2L8CL1F":RETURN
  185. 1850  '"UP ON THE HOUSE TOP"
  186. 1860  PL$="T160O3L4CL8CDL4CO2AFAO3L2CL4DDCO2AGO3CL2CL4CL8CDL4CO2AFAO3L2CL4DDCO2AGO3CO2L2FL4B-B-O3L2DL4CL8CCO2L2AL4GGL2B-L4AO3L8CCO2L2FO3L4CL8CDL4CO2AB-O3CL2DL4CL8CDCCO2L4AGO3CO2L2F":RETURN
  187. 1870  '"WE WISH YOU A MERRY CHRISTMAS"
  188. 1880  PL$="T160O2L4GO3CL8CDCO2BL4AAP32AO3DL8DEDCO2L4BGP32GO3EL8EFEDL4CO2AP32L8GGL4AO3CO2BO3C":RETURN
  189. 1890  '"JOY TO THE WORLD"
  190. 1900  PL$="T120 O3D4C#8.O2B16A4.G8F#4E4D4.A8B4.B8O3C#4.C#8D4D8D8C#8O2B8A8A8.G16F#8O3D8D8C#8O2B8A8A8.G16F#8"
  191. 1910  PL1$=" F#8F#8F#8F#8F#16G16A4.G16F#16E8E8E8E16F#16G4.F#16E16D8O3D4O2B8A8.G16F#8G8F#4E4D2"
  192. 1920  RETURN
  193. 1930  '"I HEARD THE BELLS ON CHRISTMAS DAY"
  194. 1940  PL$="ML T150G4P64G4D4G8A8B4O3C8O2B8A4G4P64G4P64G4D4G8A8B8O3C#8D4C#4D4P64D4C4O2B4O3E4.D8C4"
  195. 1950  PL1$="O2B4A4P64A4B4.O3C8D4O2A4B4A4G2"
  196. 1960  RETURN
  197. 1970  '"OH COME ALL YE FAITHFUL"
  198. 1980  PL$="MLT120 O2G8.P8G2D4G4A2D2B4A4B4O3C4O2B2A4G8.P16G2F#4E4F#4G4A4B4F#2E4.D16.P32D2.P4O3D2C4O2B4O3C2O2B2A4B4G4"
  199. 1990  PL1$="A4F#4.E8D4G8.P16G4F#4G4A4G2D4B8.P16B4A4B4O3C4O2B2A4B4O3C4O2B4A4G4F#2G4O3C4O2B2A4.G16.P32G2."
  200. 2000  RETURN
  201. 2010  '"WE THREE KINGS"
  202. 2020  PL$="T100O2B4A8G4E8F#8G8F#8E4P8B4A8G4E8F#8G8F#8E4P8G8.P16G8A8.P16A8B8.P16B8O3D8C8O2B8A8B8A8G4"
  203. 2030  PL1$="F#8E4P8F#4A2.G8.P16G8P32G4D8G4E8G4P8G8.P16G8P32G4D8G4E8G4P8G8.P16G8A4B8O3C4O2B8A4B8G8.P16G8P32G4D8G4E8G4."
  204. 2040  RETURN
  205. 2050  '"CHRISTMAS IS COMING"
  206. 2060  PL$="T175O3C2O2G4.G8O3C4C2C4C4C4O2B4A4G1O3C4.O2C8C4D4E4C4E4G4A2G4F4E1E4.F8E4D4C4O3C4O2G4E4F2G4O1B4O2C1"
  207. 2070  PL1$=PL$
  208. 2080  RETURN
  209.